home *** CD-ROM | disk | FTP | other *** search
/ FishMarket 1.0 / FishMarket v1.0.iso / fishies / 476-500 / disk_499 / diglib / diglib.lzh / source / LINLAB.for < prev    next >
Encoding:
Text File  |  1991-05-22  |  1.6 KB  |  67 lines
  1.         SUBROUTINE LINLAB(NUM,IEXP,STRNG,LRMTEX)
  2.         IMPLICIT NONE
  3.     EXTERNAL LEN
  4.         INTEGER IEXP,ISTART,N,IZBGN,NIN,IBEGIN,I
  5.         LOGICAL*1 LRMTEX
  6.     INTEGER L,NUM,NVAL,LEN
  7.     CHARACTER*1 STRNG(8)
  8. C
  9.         CHARACTER*1 BMINUS, BZERO(4)
  10.         DATA BMINUS /'-'/
  11.         DATA BZERO /'0', '.', '0',0/
  12. C
  13. C
  14.         LRMTEX = .TRUE.
  15. C
  16. C       WORK WITH ABSOLUTE VALUE AS IT IS EASIER TO PUT SIGN IN NOW
  17. C
  18.         IF (NUM .LT. 0) GO TO 10
  19.                 NVAL = NUM
  20.                 ISTART = 1
  21.                 GO TO 20
  22. 10          CONTINUE
  23.                 NVAL = -NUM
  24.                 ISTART = 2
  25.                 STRNG(1) = BMINUS
  26. 20      CONTINUE
  27.         IF (IEXP .GE. -2 .AND. IEXP .LE. 2) LRMTEX = .FALSE.
  28.         IF (IEXP .GT. 0 .AND. (.NOT. LRMTEX)) NVAL = NVAL*10**IEXP
  29. C
  30.     CALL NUMSTR(NVAL,STRNG(ISTART))
  31. C
  32.         IF ((NVAL .EQ. 0) .OR. LRMTEX .OR. (IEXP .GE. 0)) GOTO 800
  33. C
  34. C       NUMBER IS IN RANGE 10**-1 OR 10**-2, SO FORMAT PRETTY
  35. C
  36.         N = -IEXP
  37.         L = LEN(STRNG(ISTART))
  38.         IZBGN = 1
  39.         NIN = 3
  40.         IF (N .EQ. L) NIN = 2
  41. C
  42. C       IF N<L THEN WE NEED ONLY INSERT A DECIMAL POINT
  43. C
  44.         IF (N .GE. L) GO TO 40
  45.                 IZBGN = 2
  46.                 NIN = 1
  47. 40      CONTINUE
  48. C
  49. C       ALLOW ROOM FOR DECIMAL POINT AND ZERO(S) IF NECESSARY
  50. C
  51.         IBEGIN = ISTART + MAX0(0,L-N)
  52.                 DO 50 I = 0, MIN0(N,L)
  53.                 STRNG(ISTART+L+NIN-I) = STRNG(ISTART+L-I)
  54. 50              CONTINUE
  55. C
  56. C       INSERT LEADING ZEROS IF NECESSARY, OR JUST DECIMAL POINT
  57. C
  58.                 DO 60 I=0,NIN-1
  59.                 STRNG(IBEGIN+I) = BZERO(IZBGN+I)
  60. 60              CONTINUE
  61. C
  62. C       ALL DONE
  63. C
  64. 800    CONTINUE
  65.         RETURN
  66.         END
  67.